Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/runner1a/form1.frm

Visual Basic Form | 1999-09-15 | 25.8 KB | 784 lines

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Form1
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "AutoRun"
   ClientHeight    =   3810
   ClientLeft      =   45
   ClientTop       =   405
   ClientWidth     =   9840
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3810
   ScaleWidth      =   9840
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  'Windows Default
   Visible         =   0   'False
   Begin VB.ListBox List1
      Height          =   2595
      Left            =   10080
      TabIndex        =   7
      Top             =   600
      Width           =   1575
   End
   Begin VB.CommandButton Command5
      Caption         =   "Save"
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   5040
      TabIndex        =   6
      Top             =   120
      Visible         =   0   'False
      Width           =   1335
   End
   Begin VB.Timer Timer2
      Enabled         =   0   'False
      Interval        =   4000
      Left            =   600
      Top             =   3840
   End
   Begin MSComctlLib.ListView lvListView
      Height          =   2895
      Left            =   120
      TabIndex        =   2
      Top             =   600
      Width           =   9615
      _ExtentX        =   16960
      _ExtentY        =   5106
      View            =   3
      LabelEdit       =   1
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      Checkboxes      =   -1  'True
      FullRowSelect   =   -1  'True
      _Version        =   393217
      Icons           =   "ImageList1"
      SmallIcons      =   "ImageList1"
      ColHdrIcons     =   "ImageList1"
      ForeColor       =   16777215
      BackColor       =   -2147483645
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   1
      BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
         Object.Width           =   2540
      EndProperty
   End
   Begin VB.CommandButton Command4
      Caption         =   "Scan for New Entries"
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   120
      TabIndex        =   5
      Top             =   120
      Width           =   2295
   End
   Begin VB.Timer Timer1
      Enabled         =   0   'False
      Interval        =   250
      Left            =   120
      Top             =   3840
   End
   Begin VB.CommandButton Command3
      Caption         =   "De-Select All"
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   8160
      TabIndex        =   4
      Top             =   120
      Width           =   1575
   End
   Begin VB.CommandButton Command2
      Caption         =   "Select All"
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   6600
      TabIndex        =   3
      Top             =   120
      Width           =   1455
   End
   Begin MSComctlLib.ImageList ImageList1
      Left            =   4680
      Top             =   1680
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   20
      ImageHeight     =   20
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
         NumListImages   =   1
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
            Picture         =   "Form1.frx":0000
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin MSComctlLib.StatusBar StatusBar1
      Align           =   2  'Align Bottom
      Height          =   255
      Left            =   0
      TabIndex        =   0
      Top             =   3555
      Width           =   9840
      _ExtentX        =   17357
      _ExtentY        =   450
      Style           =   1
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
         NumPanels       =   1
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
         EndProperty
      EndProperty
   End
   Begin VB.CommandButton Command1
      Caption         =   "Load List"
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   600
      TabIndex        =   1
      Top             =   1440
      Visible         =   0   'False
      Width           =   1215
   End
   Begin VB.Data Data1
      Caption         =   "Data1"
      Connect         =   "Access"
      DatabaseName    =   ""
      DefaultCursorType=   0  'DefaultCursor
      DefaultType     =   2  'UseODBC
      Exclusive       =   0   'False
      Height          =   375
      Left            =   480
      Options         =   0
      ReadOnly        =   0   'False
      RecordsetType   =   1  'Dynaset
      RecordSource    =   ""
      Top             =   2040
      Width           =   2055
   End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'Private WithEvents m_cSplit As cSplitter
Private cReg As New cRegistry
Dim cancelled As Boolean
Dim retval As Boolean
Dim c As New cRegistry
Dim listitemadd As ListItem
Dim j As Integer, k As Integer
Dim sKeys() As String, iKeyCount As Long, bkey As String, ikey As Integer, dell As String, ell As String
Dim rell As String, gell As String, hell As String, nell As String, dill As String, fril As Integer
Dim nname As String, nkey As String, nsubkey As String, npath As String
Dim r As Long, q As Integer, l As Integer
Dim pathSpec As String
Dim chrsin As String, chrsout As String, idx, fuss As String, exet As Integer
Function Getname(name As String)
fuss = name '"C:\Windows\Startm~1\Programs\Startup\Shortcut to PDesk.lnk"
If InStr(fuss, "\") Then
   For idx = Len(fuss) To 1 Step -1
       If Mid(fuss, idx, 1) = "\" Then
          chrsout = Mid(fuss, idx + 36)
          exet = Len(chrsout)
          exet = exet - 3
          '
       End If
   Next idx
End If
End Function
Function Validate_File(ByVal FileName As String) As Integer
       Dim fileFile As Integer
       '     'attempt to open file
       fileFile = FreeFile
       On Error Resume Next
       Open FileName For Input As fileFile
       '     'check for error
              If Err Then
                     Validate_File = False
              Else
                     '     'file exists
                     '     'close file
                     Close fileFile
                     Validate_File = True
              End If
End Function
Function sLongName(sShortName As String) As String
       Dim sTemp As String
       Dim sNew As String
       Dim iHasBS As Integer
       Dim iBS As Integer
       If Len(sShortName) = 0 Then Exit Function
       sTemp = sShortName
       If Right$(sTemp, 1) = "\" Then
           sTemp = Left$(sTemp, Len(sTemp) - 1)
           iHasBS = True
       End If
       On Error GoTo MSGLFNnofile
       If InStr(sTemp, "\") Then
           sNew = ""
           Do While InStr(sTemp, "\")
               If Len(sNew) Then
                   sNew = Dir$(sTemp, 54) & "\" & sNew
               Else
                   sNew = Dir$(sTemp, 54)
                   If sNew = "" Then
                       sLongName = sShortName
                       Exit Function
                   End If
               End If
               On Error Resume Next
               For iBS = Len(sTemp) To 1 Step -1
                   If ("\" = Mid$(sTemp, iBS, 1)) Then
                       'found it
                       Exit For
                   End If
               Next iBS
               sTemp = Left$(sTemp, iBS - 1)
           Loop
           sNew = sTemp & "\" & sNew
       Else
           sNew = Dir$(sTemp, 54)
       End If
   Data1.Recordset.AddNew
Dim stir As String
   stir = InputBox$("FindDirectory of Application", "Find Application", "Full Path Shortcut Refers To", 150, 150) ' without commondialog
   'With CommonDialog1                   '  for use with common dialog
    ' .DialogTitle = "Find Application"  '  for use with common dialog
     '.CancelError = False               '  for use with common dialog
     '.DefaultExt = ".exe"               '  for use with common dialog
     '.InitDir = "C:\Windows\"           '  for use with common dialog
     '.ShowOpen                          '  for use with common dialog
     'stir = .FileName                   '  for use with common dialog
  ' End With                             '  for use with common dialog
If stir = "" Or stir = "Full Path Shortcut Refers To" Then Exit Function
   stir = Short_Name(stir)
   retval = Validate_File(stir)
   If retval = False Then Exit Function
   Data1.Recordset.Fields("Name") = List1.Text
   Data1.Recordset.Fields("Key") = "Start Menu"
   Data1.Recordset.Fields("Path") = sNew
   Data1.Recordset.Fields("AppLocation") = stir
   Data1.Recordset.Fields("Checked") = True
   Data1.Recordset.Fields("Subkey") = "C:\Windows\Startm~1\Programs\StartUp"
   Data1.UpdateRecord
   fril = fril + 1
MSGLFNresume:
       If iHasBS Then
           sNew = sNew & "\"
       End If
       sLongName = sNew
       Exit Function
MSGLFNnofile:
       sNew = ""
       Resume MSGLFNresume
   End Function
Function TestName(test As String)
Dim str As String
On Error GoTo errmsg
Data1.RecordSource = ("SELECT * FROM [Runit] WHERE [Name]Like """ & test & "*""")
Data1.Refresh
str = Data1.Recordset.Fields("Path")
Exit Function
errmsg:
If Err.Number = 3021 Then
MsgBox " New Entry Found in Registry.  Click on Select All then Right after, (You have 5 Seconds), Click on Scan for New Entries to Create a new Database"
cancelled = True
End If
End Function
Function Scannew()
Dim umm As Integer, frd As String
umm = 1
With c

         .ClassKey = rell
         .SectionKey = dell
         bkey = .EnumerateValues(sKeys(), iKeyCount)

         For ikey = 1 To iKeyCount
             Debug.Print sKeys(ikey)
             frd = sKeys(ikey)
             TestName (frd)
             umm = umm + 1
         Next ikey

End With
With c
         .ClassKey = hell
         .SectionKey = nell
         bkey = .EnumerateValues(sKeys(), iKeyCount)
         For ikey = 1 To iKeyCount
             Debug.Print sKeys(ikey)
             frd = sKeys(ikey)
             TestName (frd)
             umm = umm + 1
         Next ikey
End With
With c
         .ClassKey = gell
         .SectionKey = ell
         bkey = .EnumerateValues(sKeys(), iKeyCount)
         For ikey = 1 To iKeyCount
             Debug.Print sKeys(ikey)
             frd = sKeys(ikey)
             TestName (frd)
             umm = umm + 1
         Next ikey
End With
If cancelled = False Then
MsgBox "Nothing New Found in Registry"
End If
End Function
Function RemoveThing(Thing As Integer)
On Error GoTo dunn
Dim rel, fel As String, nam As String
Data1.RecordSource = ("SELECT * FROM [Runit] WHERE [ID]Like """ & Thing & "*""")
Data1.Refresh
Data1.Recordset.Edit
Data1.Recordset.Fields("Checked") = False
rel = Data1.Recordset.Fields("Key")
fel = Data1.Recordset.Fields("Subkey")
nam = Data1.Recordset.Fields("Name")
Data1.Recordset.Update
Select Case rel
Case "HKEY_LOCAL_MACHINE"
rel = HKEY_LOCAL_MACHINE
Case "HKEY_CURRENT_USER"
rel = HKEY_CURRENT_USER
End Select
 With c
         .ClassKey = rel
         .SectionKey = fel
         .ValueKey = nam
         .DeleteValue
 End With
 Exit Function
dunn:
 If Err.Number = 26001 Then
 Exit Function
 Else
 MsgBox Err.Number
 End If
End Function
Function AddThing(Thing As Integer)
Dim rel As String, fel As String, nam As String, frt As String
Data1.RecordSource = ("SELECT * FROM [Runit] WHERE [ID]Like """ & Thing & "*""")
Data1.Refresh
Data1.Recordset.Edit
Data1.Recordset.Fields("Checked") = True
rel = Data1.Recordset.Fields("Key")
fel = Data1.Recordset.Fields("Subkey")
nam = Data1.Recordset.Fields("Name")
frt = Data1.Recordset.Fields("Path")
Data1.Recordset.Update
Select Case rel
 Case "HKEY_LOCAL_MACHINE"
  Call savestring(HKEY_LOCAL_MACHINE, fel, nam, frt)
 Case "HKEY_CURRENT_USER"
  Call savestring(HKEY_CURRENT_USER, fel, nam, frt)
End Select
End Function
Function ReadBase()
Call Columns
On Error GoTo errmsg
  Data1.Recordset.MoveLast
  j = Data1.Recordset.RecordCount
  Data1.Recordset.MoveFirst
  k = 1
Do Until Data1.Recordset.EOF
Set listitemadd = lvListView.ListItems.Add(, , Data1.Recordset.Fields("Name"), 0)
  lvListView.ListItems(k).Checked = Data1.Recordset.Fields("Checked")
  lvListView.ListItems(k).Tag = Data1.Recordset.Fields("ID")
  listitemadd.SubItems(1) = Data1.Recordset.Fields("Key")
  listitemadd.SubItems(2) = Data1.Recordset.Fields("Path")
  Data1.Recordset.MoveNext
  k = k + 1
Exit Function
errmsg:
If Err.Number = 3021 Then
  With c
         .ClassKey = HKEY_CURRENT_USER
         .SectionKey = "Software\Homeplay\Runner"
         .ValueKey = "Done"
         .DeleteValue
 End With
  MsgBox "There was an Error. Please Restart Runner"
  End
End If
End Function
Function CreateBase()
Call Columns
     With c

         .ClassKey = rell
         .SectionKey = dell
         bkey = .EnumerateValues(sKeys(), iKeyCount)

         For ikey = 1 To iKeyCount
             Debug.Print sKeys(ikey)
            Set listitemadd = lvListView.ListItems.Add(, , sKeys(ikey), 0)
            lvListView.ListItems(fril).Checked = True
            listitemadd.SubItems(1) = "HKEY_LOCAL_MACHINE"
            listitemadd.SubItems(2) = getstring(HKEY_LOCAL_MACHINE, dell, sKeys(ikey))
         Data1.Recordset.AddNew
         Data1.Recordset.Fields("Name") = sKeys(ikey)
         Data1.Recordset.Fields("ID") = fril
         Data1.Recordset.Fields("Key") = "HKEY_LOCAL_MACHINE"
         Data1.Recordset.Fields("Path") = getstring(HKEY_LOCAL_MACHINE, dell, sKeys(ikey))
         Data1.Recordset.Fields("Subkey") = dell
         Data1.Recordset.Fields("Checked") = True
         Data1.UpdateRecord
         fril = fril + 1
         Next ikey
     End With

     With c
         .ClassKey = hell
         .SectionKey = nell
         bkey = .EnumerateValues(sKeys(), iKeyCount)
         For ikey = 1 To iKeyCount
             Debug.Print sKeys(ikey)
            Set listitemadd = lvListView.ListItems.Add(, , sKeys(ikey), 0)
            lvListView.ListItems(fril).Checked = True
            listitemadd.SubItems(1) = "HKEY_LOCAL_MACHINE"
            listitemadd.SubItems(2) = getstring(HKEY_LOCAL_MACHINE, nell, sKeys(ikey))
         Data1.Recordset.AddNew
         Data1.Recordset.Fields("Name") = sKeys(ikey)
         Data1.Recordset.Fields("ID") = fril
         Data1.Recordset.Fields("Key") = "HKEY_LOCAL_MACHINE"
         Data1.Recordset.Fields("Path") = getstring(HKEY_LOCAL_MACHINE, nell, sKeys(ikey))
         Data1.Recordset.Fields("Checked") = True
         Data1.Recordset.Fields("Subkey") = nell
         Data1.UpdateRecord
         fril = fril + 1
         Next ikey
     End With

      With c
         .ClassKey = gell
         .SectionKey = ell
         bkey = .EnumerateValues(sKeys(), iKeyCount)
         For ikey = 1 To iKeyCount
             Debug.Print sKeys(ikey)
            Set listitemadd = lvListView.ListItems.Add(, , sKeys(ikey), 0)
            lvListView.ListItems(fril).Checked = True
            listitemadd.SubItems(1) = "HKEY_CURRENT_USER"
            listitemadd.SubItems(2) = getstring(HKEY_CURRENT_USER, dell, sKeys(ikey))
            Data1.Recordset.AddNew
         Data1.Recordset.Fields("Name") = sKeys(ikey)
         Data1.Recordset.Fields("ID") = fril
         Data1.Recordset.Fields("Key") = "HKEY_CURRENT_USER"
         Data1.Recordset.Fields("Path") = getstring(HKEY_CURRENT_USER, dell, sKeys(ikey))
         Data1.Recordset.Fields("Checked") = True
         Data1.Recordset.Fields("Subkey") = dell
         Data1.UpdateRecord
         fril = fril + 1
         Next ikey
     End With

     With c
         .ClassKey = gell
         .SectionKey = ell
         bkey = .EnumerateValues(sKeys(), iKeyCount)
         For ikey = 1 To iKeyCount
             Debug.Print sKeys(ikey)
            Set listitemadd = lvListView.ListItems.Add(, , sKeys(ikey), 0)
            lvListView.ListItems(fril).Checked = True
            listitemadd.SubItems(1) = "HKEY_CURRENT_USER"
            listitemadd.SubItems(2) = getstring(HKEY_CURRENT_USER, ell, sKeys(ikey))
            Data1.Recordset.AddNew
         Data1.Recordset.Fields("Name") = sKeys(ikey)
         Data1.Recordset.Fields("Key") = "HKEY_CURRENT_USER"
         Data1.Recordset.Fields("Path") = getstring(HKEY_CURRENT_USER, ell, sKeys(ikey))
         Data1.Recordset.Fields("Checked") = True
         Data1.Recordset.Fields("Subkey") = nell
         Data1.UpdateRecord
         fril = fril + 1
         Next ikey
     End With

        l = 1
        pathSpec = "C:\WINDOWS\Startm~1\Programs\StartUp\*.*"
        r = SendMessageStr(List1.hwnd, LB_DIR, DDL_FLAGS, pathSpec)
        q = List1.ListCount
        Do Until l = q
        List1.ListIndex = l
        sLongName ("C:\WINDOWS\Startm~1\Programs\StartUp\" & List1.Text)
        l = l + 1
        fril = fril + 1
        Loop

End Function
Sub Columns()
lvListView.Sorted = False
lvListView.ColumnHeaders.Clear
lvListView.ListItems.Clear
      lvListView.ColumnHeaders.Add
      lvListView.ColumnHeaders.Item(1).Text = "Name"
      lvListView.ColumnHeaders.Item(1).Width = 2700
      lvListView.ColumnHeaders.Add
      lvListView.ColumnHeaders.Item(2).Text = "Location"
      lvListView.ColumnHeaders.Item(2).Width = 2300
      lvListView.ColumnHeaders.Add
      lvListView.ColumnHeaders.Item(3).Text = "Run Path"
      lvListView.ColumnHeaders.Item(3).Width = 5200
End Sub
Private Sub Command1_Click()
Dim dun As String
  dun = getstring(HKEY_CURRENT_USER, "Software\Homeplay\Runner", "Done")
If dun <> "Yes" Then
Call savestring(HKEY_CURRENT_USER, "Software\Homeplay\Runner", "Done", "Yes")
  CreateBase
Exit Sub
End If
If dun = "Yes" Then
  ReadBase
Exit Sub
End If
End Sub
Private Sub Command2_Click()
Command5.Visible = True
Cretnew = True
Timer2.Enabled = True
StatusBar1.SimpleText = ""
Dim i As Integer, k As Integer
 i = lvListView.ListItems.Count
 k = 1
Do Until k = i + 1
  lvListView.ListItems(k).Checked = True
  k = k + 1
  Data1.Recordset.MoveFirst
Do Until Data1.Recordset.EOF
  Data1.Recordset.Edit
  Data1.Recordset.Fields("Checked") = True
  Data1.Recordset.Update
  Data1.Recordset.MoveNext
Data1.RecordSource = "Select * From [Runit]"
Data1.Refresh
Data1.Recordset.MoveFirst
Do Until Data1.Recordset.EOF
  nname = Data1.Recordset.Fields("Name")
  nkey = Data1.Recordset.Fields("Key")
  nsubkey = Data1.Recordset.Fields("Subkey")
  npath = Data1.Recordset.Fields("Path")
  Call Wait(0.125)
  Select Case nkey
  Case "HKEY_LOCAL_MACHINE"
    Call savestring(HKEY_LOCAL_MACHINE, nsubkey, nname, npath)
  Case "HKEY_CURRENT_USER"
    Call savestring(HKEY_CURRENT_USER, nsubkey, nname, npath)
  End Select
  On Error GoTo endr
  Data1.Recordset.MoveNext
endr:
End Sub
Private Sub Command3_Click()
StatusBar1.SimpleText = ""
Command5.Visible = True
Dim i As Integer, k As Integer
  i = lvListView.ListItems.Count
  k = 1
Do Until k = i + 1
  lvListView.ListItems(k).Checked = False
  k = k + 1
Data1.Recordset.MoveFirst
Do Until Data1.Recordset.EOF
  Data1.Recordset.Edit
  Data1.Recordset.Fields("Checked") = False
  Data1.Recordset.Update
  Data1.Recordset.MoveNext
Data1.RecordSource = "Select * From [Runit]"
Data1.Refresh
Data1.Recordset.MoveFirst
Do Until Data1.Recordset.EOF
  nname = Data1.Recordset.Fields("Name")
  nkey = Data1.Recordset.Fields("Key")
  nsubkey = Data1.Recordset.Fields("Subkey")
  npath = Data1.Recordset.Fields("Path")
  Call Wait(0.125)
  Select Case nkey
  Case "HKEY_LOCAL_MACHINE"
    With c
         .ClassKey = HKEY_LOCAL_MACHINE
         .SectionKey = nsubkey
         .ValueKey = nname
         .DeleteValue
    End With
  Case "HKEY_CURRENT_USER"
    Call savestring(HKEY_CURRENT_USER, nsubkey, nname, npath)
    With c
         .ClassKey = HKEY_CURRENT_USER
         .SectionKey = nsubkey
         .ValueKey = nname
         .DeleteValue
 End With
  End Select
  Data1.Recordset.MoveNext
End Sub
Private Sub Command4_Click()
StatusBar1.SimpleText = ""
Command5.Visible = False
If Cretnew = False Then
Scannew
Exit Sub
End If
With c
         .ClassKey = HKEY_CURRENT_USER
         .SectionKey = "Software\Homeplay\Runner"
         .ValueKey = "Done"
         .DeleteValue
 End With
 Columns
 Data1.Recordset.MoveFirst
 Do Until Data1.Recordset.EOF
 Data1.Recordset.Delete
 Data1.Recordset.MoveNext
 Loop
MsgBox "You will need to restart Runner to Create a new database"
End Sub
Private Sub Command5_Click()
MsgBox "Something left for you to do. Once all are selected you will need to save the changes :)"
End Sub
Private Sub Form_Load()
  ikey = 0
  rell = HKEY_LOCAL_MACHINE
  dell = "Software\Microsoft\Windows\CurrentVersion\Run"
  gell = HKEY_CURRENT_USER
  ell = "Software\Microsoft\Windows\CurrentVersion\Run"
  hell = HKEY_LOCAL_MACHINE
  nell = "Software\Microsoft\Windows\CurrentVersion\RunServices"
  fril = 1
  cancelled = False
Data1.DatabaseName = App.Path & "\Runner.mdb"
Data1.RecordSource = "Runit"
    Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 1000)
    Me.Top = GetSetting(App.Title, "Settings", "MainTop", 1000)
    Me.Width = GetSetting(App.Title, "Settings", "MainWidth", 9960)
    Me.Height = GetSetting(App.Title, "Settings", "MainHeight", 4230)
Timer1.Enabled = True
End Sub
Private Sub Form_Unload(Cancel As Integer)
    If Me.WindowState <> vbMinimized Then
        SaveSetting App.Title, "Settings", "MainLeft", Me.Left
        SaveSetting App.Title, "Settings", "MainTop", Me.Top
        SaveSetting App.Title, "Settings", "MainWidth", Me.Width
        SaveSetting App.Title, "Settings", "MainHeight", Me.Height
    End If
End Sub
Private Sub lvListView_ItemCheck(ByVal Item As MSComctlLib.ListItem)
Dim agr As String, strr As String
StatusBar1.SimpleText = Item
Command5.Visible = False
Dim tagr As Integer
  lvListView.SelectedItem = Item
 If Not IsNull(lvListView.SelectedItem.Tag) Then
 tagr = lvListView.SelectedItem.Tag
 End If
If Right(Item, 4) = ".lnk" Then
GoTo starmen
End If
If lvListView.SelectedItem.Checked = True Then
  AddThing (tagr)
Exit Sub
End If
If lvListView.SelectedItem.Checked = False Then
  RemoveThing (tagr)
Exit Sub
End If
starmen:
Dim tell As String, apploc As String
If lvListView.SelectedItem.Checked = True Then
agr = lvListView.SelectedItem
Data1.RecordSource = ("Select * From [Runit] Where [Name]Like """ & agr & "*""")
Data1.Refresh
Data1.Recordset.Edit
Data1.Recordset.Fields("Checked") = True
strr = Data1.Recordset.Fields("Path")
apploc = Data1.Recordset.Fields("AppLocation")
Getname (strr)
Data1.Recordset.Update
Dim abb As String, dab As Integer
dab = Len(chrsout)
abb = Mid(chrsout, 1, dab - 4)
Call CreateShortcut(Me, "..", abb, apploc, "")
Call Wait(0.125)
FileCopy ("C:\Windows\Startm~1\" & abb & ".lnk"), ("C:\Windows\Startm~1\Programs\Startup\" & abb & ".lnk")
Call Wait(0.125)
Kill ("C:\Windows\Startm~1\" & abb & ".lnk")
Exit Sub
End If
If lvListView.SelectedItem.Checked = False Then
agr = lvListView.SelectedItem
Data1.RecordSource = ("Select * From [Runit] Where [Name]Like """ & agr & "*""")
Data1.Refresh
Data1.Recordset.Edit
Data1.Recordset.Fields("Checked") = False
Data1.Recordset.Update
strr = Data1.Recordset.Fields("Path")
strr = Short_Name(strr)
retval = Validate_File(strr)
If retval = True Then
Kill strr
End If
Exit Sub
End If
End Sub
Private Sub lvListView_ItemClick(ByVal Item As MSComctlLib.ListItem)
StatusBar1.SimpleText = Item
End Sub
Private Sub Timer1_Timer()
  Command1.Value = True
  Timer1.Enabled = False
  Form1.Visible = True
  StatusBar1.SimpleText = lvListView.ListItems.Count & " Running Applications"
End Sub
Private Sub Timer2_Timer()
Cretnew = False
Command5.Visible = False
Timer2.Enabled = False
End Sub